perm filename SCR5A.F4[M5,LCS] blob
sn#153745 filedate 1975-07-16 generic text, type T, neo UTF8
C THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C AT STANFORD UNIVERSITY. IT MAY NOT BE COPIED OR ALTERED IN ANY
C WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
C LOAD 'SCORE' WITH BRZ.REL (RANDOM NUMBER GENERATOR AND 'ZERPP') -
C AND, IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C SUBROUTINE SUBR
C COMMON/X/P(30),INST,IPAR,CNT(25),BT,IREST,CVT(35),PL(30),DF,DUR(25)
C INST=INST#. IPAR=PARAM#. DF=DUTY FACTOR. WHEN SUBROUTINE IS CALLED
COMMON/X/P(30),J,L,CNT(25),BT,MK,VX(35),PL(30),DF,DUR(26),TF,
1XT(25),ROFF(25),V(2000),NP(25),PCH(25,32),INST(26),IXIN,NINS,IALL,
1DURX,AMPFAC,IT(30),I,OP1,INUM(25),BG(80),INP(72),TP,
1CVTX,ISCA(12),IDAT(11),IQ(25),SCAL(86),MU5(14)
1,LIST(78),INVIS(25),RDEV(25),IBLA,KSLA,ICOM,ISEMI,IMIN,ISTAR
1,IEL,IPLUS
COMMON/SC/ML,JJ,NNUM,NFLG,JA,ISUB,CODE,IAMP,M
COMMON /Q/ BNW(40),NWZ
COMMON/FINE/LK
COMMON/RW/NWRITE,NDEC,LPT,DEBUG,KZY
DIMENSION IV(2000)
DATA IPLAY/'PLAY'/,IEND/'END'/,ISECT/'SECT'/,ITMPO/'TEMP'/
1,IRUN2/'RUN;'/,IRUN/'RUN'/,KZY/25/,IVV/'V'/
1,ILFP/'('/,IAT/'@'/,IRTP/')'/,IDOL/'$'/,IFINI/'FINI'/
EQUIVALENCE (VX2,VX(2)),(VX1,VX(1))
1,(IPP,ISCA(2)),(VX3,VX(3)),(IEN,ISCA(4)),(IE,ISCA(5))
1,(VX4,VX(4)),(VX5,VX(5)),(VX6,VX(6)),(IU,ISCA(7)),(ITT,MU5(1))
1,(ISS,ISCA(9)),(ID,ISCA(3)),(IF,ISCA(6)),(IDOT,
1IDAT(11)),(IEM,MU5(12)),(II,MU5(10)),(IR,MU5(6)),(IXX,MU5(9))
1,(IG,ISCA(8)),(IAA,ISCA(10)),(IV(1),V(1))
C IF DIMENS. ARE CHANGED, CHANGE KZY. ALL CHNGS MUST BE MULTS OF KZY.
C SET INST(KZY+1), CHECK BG, CHECK BLOCK DATA VALUES.
CVTX=10000.
CALL INSTS
LPAR=0
DO 1900 K=1,KZY
1900 INUM(K)=K
IPRN=0
QX=0.
MOT=0
RETRO=-1.
INVRT=-1
LCNT=1
PARENS=0
JZ=1
PR=0
IAMP=0
C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
T5=0
NINS=0
K=0
IDALL=-1
BT=0
NWZ=1
BNW(1)=0
I=1
KL=0
TP=0
KN=IBLA
RA=0
CHN=0
DO 127 K=1,77,3
127 LIST(K)=0
C INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
NWX=0
BY=-1
DO 1128 K=1,KZY
INVIS(K)=0
INST(K)=0
CNT(K)=0
RDEV(K)=0
C RDEV IS FOR RAND DEVIATIONS AT RUN TIME
NP(K)=0
IQ(K)=0
C IQ IS FOR RESTART FLAG
DO 1128 L=1,32
1128 PCH(K,L)=0
2308 JREAD=1
4400 READ(NDEC,1007)LN,J,INP
C****** LN=LINE NUM, J=INST NAME *******
WRITE(LPT,1007)LN,J,INP
1007 FORMAT(I,A4,72A1)
441 IF(J.EQ.IBLA)GO TO 4400
MLX=1
IZ=0
JA=-1
ISUB=4
ALL=1.
VX1=0
VX2=0
VX3=0
LK=-1
K=0
IF(V(I-1).NE.-9900.-BY)GO TO 364
BY=-1.
I=I-1
364 DO 361 JD=1,72
N=INP(JD)
IF(N.NE.IR)GO TO 361
C LOOKS FOR 'RESTART'
DO 3611 M=JD,72
KL=INP(M)
IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.ICOM)GO TO 3631
3611 INP(M)=IBLA
C CHANGES 'RESTART' TO BLANKS
3631 DO 363 N=1,NINS
IF(J.NE.INST(N))GO TO 363
IQ(N)=-1
C SETS RESTART FLAG. THIS INST WILL NOW APPEAR WITH NEW NUM.
GO TO 362
363 CONTINUE
361 IF(N.EQ.KSLA.OR.N.EQ.ISEMI)GO TO 6773
6773 K=K+1
IF(K.GT.NINS)GO TO 36
IF(INST(K).NE.J.OR.IQ(K).EQ.-1)GO TO 6773
C FINDS CORRECT INST NUM. PASSES RESTARTED INSTS.
LK=K
GO TO 1773
36 IF(J.EQ.IRUN2.OR.J.EQ.IRUN)CALL RUNIT
IF(J.EQ.ITMPO.OR.J.EQ.IPLAY.OR.ISUB.GT.4)GO TO 1773
IF(J.EQ.ISECT)GO TO 1081
C****************** ABOVE AND BELOW FOR 'SECTIONS'
IF(J.EQ.IEND.OR.J.EQ.IFINI)GO TO 1082
362 LK=NINS+1
IF(LK.GT.KZY)GO TO 99
INST(LK)=J
IZ=LK
GO TO 1773
C*********** DOWN TO 99 FOR 'SECTIONS'
1083 V(I)=-99.
KL=1
GO TO 3083
C READS 'PLAY SECT. N1,N2'
1081 V(I)=-199.
KL=4
3083 DO 2081 K=KL,72
IF(INP(K).EQ.IBLA)GO TO 2081
IV(I+1)=INP(K)
I=I+2
3081 BY=-1.
GO TO 2308
2081 CONTINUE
C READS SECTION IDENTIFIER, -199. MARKS BEGINNING
C1082 IF(V(I-1).EQ.-9900.-BY)I=I-1
C********* FEB 15,71
1082 V(I)=-299.
I=I+1
GO TO 3081
C MARKS END OF SECTION
C************************
99 WRITE(LPT,199)LN
C****** TYPE IS FOR PDP10 *********
STOP
199 FORMAT(' ERROR!! LAST LINE READ =',I6/)
4 IF(LK.LE.NINS)GO TO 8773
IF(ALL.GT.0)GO TO 1004
IF(IDALL.GT.0)GO TO 8773
BG(LK)=VX1
IDALL=LK
GO TO 2004
C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
1004 BG(LK)=VX1
IF(LK.EQ.IZ)VX1=0
C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
C CHECK EFFECT ON 'MOVE'!
C ******** APR.23, 1971 FIXES BG TIMES IN 'MOVE'?????!!!!!!!
2004 NINS=LK
IF(VX3.NE.0)VX2=10000.+VX3
IF(VX2.EQ.0)VX2=-1
DUR(LK)=VX2
GO TO 900
C******** ABOVE FOR REST ONLY ENTRIES. FEB 18,71
8773 IF(VX2.NE.0)VX1=VX1*10000.+VX2
900 IF(VX1.EQ.BY.AND.J.NE.IPLAY)GO TO 5773
C*********** 'PLAY' IS FOR 'SECTIONS'
BY=VX1
C BY=CURRENT BG TIME.
C********* FEB 15,71
V(I)=-9900.-BY
I=I+1
IF(NWZ.NE.0)CALL BGSORT(BY)
5773 IF(J.EQ.ITMPO)GO TO 1106
IF(J.EQ.IPLAY)GO TO 1083
C*********** ABOVE FOR 'SECTIONS'
4773 NW=LPAR
CC IF(I.GT.1900.)TYPE 107,I
C *********** TYPE IS FOR PDP10 -- GIVES WARNING NEAR END OF V *******
ALL=1.
CVT=0
DF=0
ISUB=1
1299 IF(JZ.NE.0)GO TO 1773
77732 FORMAT(72A1)
87732 FORMAT(1X72A1)
7773 READ(NDEC,2114)LN,INP
WRITE(LPT,2114)LN,INP
442 IF(INP(1).EQ.IBLA)GO TO 7773
77733 MLX=1
C 'LISTS' MUST END WITH *
1773 IF(IPRN.EQ.0)GO TO 17732
L=I-1
IF(V(I-1).EQ.999.)L=L-1
IPRN=IPRN-1
IF(PARENS.EQ.0)GO TO 17733
PARENS=0
LIST(LCNT+2)=L
LCNT=LCNT+3
IF(IPRN.EQ.0)GO TO 17732
IPRN=0
17733 LIST(MOT)=L
MOT=0
C FOR ERROR TRAP
17732 JZ=0
N=0
17731 ML=MLX
C FOR MUSIC5 CONVERSIONS (512/SRATE)
C BIG LOOP -- TO END OF PAGE 1.
JD=ML
975 N=INP(JD)
JD1=JD+1
IF(N.EQ.IBLA.OR.N.EQ.ICOM)GO TO 236
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC. CAN USE 26 LABELS.
33611 IF(N.NE.ILFP.AND.N.NE.IRTP)GO TO 2361
INP(JD)=IBLA
L=JD-1
5113 IF(INP(L).NE.IBLA)GO TO 2113
L=L-1
GO TO 5113
2113 IF(N.EQ.IRTP)GO TO 3361
IF(PARENS.EQ.0)GO TO 1140
LCNT=LCNT+3
IF(MOT.NE.0)GO TO 11403
MOT=LCNT-1
1140 N=LCNT-1
DO 11401 JC=1,N,3
IF(INP(L).NE.LIST(JC))GO TO 11401
C FINDS DUPLICATE IDENTIFIER
WRITE(LPT, 11402)INP(L)
GO TO 99
11403 WRITE(LPT, 11404)
GO TO 99
11404 FORMAT(' MORE THAN 2 PARENS OPEN'/)
11402 FORMAT(' MOTIVIC (',A1,') USED TWICE')
11401 CONTINUE
LIST(LCNT)=INP(L)
PARENS=-1.
INP(L)=IBLA
LIST(LCNT+1)=I
GO TO 236
3361 IPRN=IPRN+1
GO TO 236
2361 IF(N.NE.IAT)GO TO 5361
DO 113 L=1,72
K=JD+L
C K IS USED AT 240!!!
JG=INP(K)
IF(JG.NE.IMIN)GO TO 6113
RETRO=0
INP(K)=IBLA
GO TO 113
6113 IF(JG.NE.IDOL)GO TO 7113
C '$' IS FOR INVERSIONS IN 'NOTES'
INVRT=0
GO TO 113
7113 IF(JG.NE.IBLA)GO TO 4113
113 CONTINUE
4113 DO 6361 L=1,LCNT,3
IF(JG.NE.LIST(L))GO TO 6361
VX1=0
JDO=JD+2
DO 40 M=JDO,72
JG=INP(M)
IF(JG.EQ.IBLA)GO TO 40
IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.ISTAR)GO TO 140
ML=M
GO TO 240
40 CONTINUE
240 JC=JA
JA=-1
INP(K)=IBLA
CALL SCANR
JA=JC
140 JC=1
KN=LIST(L+1)
M=LIST(L+2)+1
IF(RETRO.LT.0)GO TO 640
JC=M-1
M=KN-1
KN=JC
JC=-1
RETRO=-1.
640 IF(INVRT.LT.0)GO TO 940
840 X=V(KN)
V(I)=X+VX1
C FINDS CENTER FOR INVERSION (+TRANSP.)
I=I+1
KN=KN+JC
IF(V(KN-JC).NE.85.)GO TO 940
V(I-1)=85.
GO TO 840
940 Z=V(KN)
IF(INVRT.EQ.0)GO TO 440
IF(VX1.EQ.0)GO TO 540
C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
IF(CODE.EQ.-33.)GO TO 440
V(I)=Z*VX1
GO TO 7361
440 IF(Z.EQ.85.)GO TO 540
Y=0
IF(INVRT.EQ.0)Y=(X-Z)*2.
V(I)=Z+VX1+Y
GO TO 7361
540 V(I)=Z
7361 I=I+1
KN=KN+JC
IF(KN.NE.M)GO TO 940
INVRT=-1
RB=V(I-1)
DO 8361 L=JD,72
JG=INP(L)
C PUT IN NOV 25, 72
IF(JG.EQ.ISEMI)GO TO 93612
INP(L)=IBLA
IF(JG.EQ.KSLA)GO TO 9361
IF(JG.EQ.IRTP)IPRN=IPRN+1
8361 IF(JG.EQ.ISTAR)IAMP=-1
9361 MLX=L
C NOTE DIFFERENCES IN SCOLB FROM HERE TO 43611
IF(IAMP.EQ.0)GO TO 1773
JZ=-1
93612 IF(IAMP.EQ.0)GO TO 93611
C NOV 25, 72
GO TO 3013
93611 IF(JG.EQ.ISEMI)GO TO 7773
JZ=0
IF(IPRN.NE.0)GO TO 1773
GO TO 236
6361 CONTINUE
GO TO 99
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361 IF(N.NE.ID.OR.ISUB.NE.1)GO TO 53611
IF(INP(JD+1).NE.IF)GO TO 5362
C JUMP IF NOT DUTY FACTOR
DF=DF-100.
GO TO 43615
53611 IF(N.NE.ISS.OR.INP(JD+1).NE.'U')GO TO 53612
DF=DF-200
C FOR SUBROUTINE FLAG. CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
GO TO 43615
53612 IF(N.NE.IAA)GO TO 53613
C FINDS 'ALL'.
IF(INP(JD+1).NE.'L')GO TO 236
ALL=-1.
GO TO 43615
53613 IF(N.NE.IF.OR.INP(JD1).NE.IR)GO TO 43611
C JUMP IF NOT "FREQ"
CVT=-1
GO TO 43615
5362 IF(INP(JD+2).NE.IR.OR.INP(JD1).NE.IU)GO TO 236
C JUMP IF NOT "DUR"
CVT=1
GO TO 43615
C FOR DUTY FACTOR
C TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
43611 IF(ISUB.NE.4)GO TO 43613
IF(N.NE.IG)GO TO 43616
C NEXT MAKES INST NAME, P1 AND P2 INVISIBLE (FOR GEN AND VAR)
INVIS(LK)=-1
GO TO 43615
43616 IF(N.NE.IVV)GO TO 43613
INVIS(LK)=1
43615 DO 43614 L=JD,72
N=INP(L)
IF(N.EQ.IBLA.OR.N.EQ.ICOM.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
43614 INP(L)=IBLA
43613 IF(N.NE.KSLA)GO TO 636
MLX=JD1
JZ=-1
INP(JD)=ISEMI
436 IF(INP(MLX).NE.IBLA)GO TO 336
MLX=MLX+1
GO TO 436
636 IF(N.NE.ISEMI)GO TO 936
336 IF(ISUB.GT.3)GO TO 1899
GO TO (101,102,103),ISUB
C PAR MOV LIST OTHERS
936 IF(N.NE.IDOT)GO TO 736
L=INP(JD1)
DO 836 KL=1,10
836 IF(L.EQ.IDAT(KL))GO TO 236
IF(CODE.EQ.-22.)INP(JD)=1
GO TO 236
C CHANGES DOTTED RHYTHMS TO '1'S.
736 IF(N.NE.ISTAR)GO TO 236
IAMP=-1
INP(JD)=IBLA
236 JD=JD1
IF(JD.LT.73)GO TO 975
GO TO 99
101 NX=INP(ML)
IZ=ML
ML=ML+1
IF(NX.EQ.IBLA)GO TO 101
C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
JA=-1
IF(NX.EQ.IPP)GO TO 1
IF(NX.EQ.IE)GO TO 2308
IF(NX.EQ.IR)CALL RUNIT
C 'RUN' MAY REPLACE 'END' FOR LAST INST.
C LOOKS FOR PARAM, END, RUN OR I(=INS NUM.)
IF(NX.EQ.ID)GO TO 7720
IF(NX.NE.II)GO TO 99
1 CALL SCANR
LPAR=VX1
IF(NX.NE.II)GO TO 5703
INUM(LK)=LPAR
C RESETS "INS" NUMBER
GO TO 1299
5703 IF(LPAR.EQ.2)CVT=1
C P2 AND RHY ALWAYS CONVERT AS "DUR"
IJ=LPAR
IAMP=0
IF(IJ.GT.NP(LK).AND.IJ.LT.31)NP(LK)=IJ
IF(LPAR.EQ.32)LPAR=1
V(I)=LPAR+LK*10000
C +1=WDCNT, +2=CODE, +3='NM' CCCCC
IJ=I+1
I=I+4
ITMP=0
CODE=0
NFLG=1
ML=IZ+M
C RE=REP R=RHY L=LIT M=MOVE MX=MOVX N=NOTES NU=NUM
C S=SUBR RL=RLIST RN=RNOTES
5702 ML=ML+1
IF(ML.GT.72)GO TO 99
N=INP(ML)
IF(N.EQ.IBLA.OR.N.EQ.ICOM)GO TO 5702
NL=INP(ML+1)
JA=-1
ISUB=0
IF(N.EQ.IXX)GO TO 2703
IF(N.EQ.IR)GO TO 6702
4005 JA=0
IF(N.EQ.IEN)GO TO 6005
IF(N.EQ.IEM)GO TO 703
IF(N.EQ.ISS)GO TO 6703
IF(N.EQ.ISEMI)GO TO 2018
IF(N.EQ.IPP)JA=-1
C FOR /P5 P3/
CALL SCANR
I=I+JJ
V(IJ+1)=NNUM+DF
IF(JJ.EQ.1)GO TO 4006
C IF NNUM IS '-2' THEN NOTES ARE PRINTED
IF(NNUM.NE.-2)GO TO 5006
CVT=-1
IX=IJ+3
DO 2006 K=2,JJ,3
2006 CALL RANR(VX,K)
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
5006 IX=IJ+2
DO 6006 K=1,JJ
6006 V(IX+K)=VX(K)
GO TO 3013
4006 IF(JA.LT.0)VX1=VX1/100.+9999.
C CHANGES /P5 P3/ TO /P5 9999.03/
V(I-1)=VX1
IF(NNUM.EQ.-2)CVT=-1.
GO TO 3013
6702 IF(NL.EQ.IE)GO TO 2703
C JUMP IF "REP"
IF(NL.EQ.IEL)GO TO 6704
IF(NL.EQ.IEN)GO TO 6705
CVT=1
CODE=-22
GO TO 1016
6704 CODE=-46.0
C FOR "RLIST" (LIST OF RAND SELECTIONS)
GO TO 1016
C JUMP IF NOT "RNOTES"
6705 JA=0
C FOR SCANR
CODE=-36.
GO TO 7
6005 IF(NL.EQ.IU)GO TO 6706
CODE=-33
7 CVT=-1
GO TO 1016
6706 CODE=-44.
1610 JA=-1
GO TO 1016
703 BW=V(IJ-2)
IC=0
JDO=ML+1
DO 7031 K=JDO,72
IF(INP(K).EQ.ISEMI)GO TO 8031
7031 IF(INP(K).EQ.IXX)IC=-1
C**************** JUNE 1,71 X 4
8031 I=I-1
V(I)=0
C ********* FEB. 15,71
X=-9900.-BY
IF(BY.EQ.0)X=-9900.-BG(LK)
IF(BW.EQ.X)GO TO 8005
IF(BW.NE.-9900.-BY)GO TO 1102
V(IJ-2)=X
GO TO 8005
1102 V(IJ)=V(IJ-1)
V(IJ-1)=X
IJ=IJ+1
I=I+1
8005 LP=IJ-1
BW=-9900.-X
ISUB=2
IZ=-1
C ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
GO TO 1299
102 IF(IZ.LT.0)GO TO 2102
BW=V(ICT)+BW
V(I)=-9900.-BW
V(I+1)=V(LP)
V(I+2)=(JJ+3)*ALL
C 3 LEAVES ROOM FOR CNVRT CODE AT END.
V(I+3)=CODE+DF
I=I+4
IZ=1
2102 IF(BW.LT.10000.)CALL BGSORT(BW)
C ROUND-OFF NONSENSE
2 VX3=-9900.
VX2=VX3
CALL SCANR
IF(JJ.GT.0)GO TO 5102
JJ=ILIT
C SLASH WILL REPEAT MOVE INPUT -- 6/74
DO 6102 K=1,JJ
6102 VX(K)=VX(K+20)
GO TO 5005
C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
5102 IF(JJ.EQ.4)GO TO 99
IF(VX3.NE.-9900.)GO TO 3102
IF(VX2.NE.-9900.)GO TO 4102
VX2=VX1
VX1=10000.
4102 VX3=VX2
JJ=3
C 1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
3102 IF(IZ.GE.0)GO TO 3006
V(IJ)=(JJ+3)*ALL
C**** +3 FOR MUSIC5 ******
C WORD COUNT
CODE=-55.
IF(JJ.NE.3)CODE=-57.
C THIS IS NOW OUT, FEB 15,70. -10000. MEANS 'NOTES AT BG TIME 0'
IF(NFLG.LT.0)CODE=CODE-1.
IF(IC.LT.0)CODE=-59.
C**************** JUNE 1,71
C CODE=-56 OR -58 FOR NOTES.
V(IJ+1)=CODE+DF
IZ=0
3006 IF(NFLG.EQ.1)GO TO 5005
CVT=-1
CALL RANR(VX,2)
IF(JJ.NE.3)CALL RANR(VX,4)
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
5005 ICT=I
ILIT=JJ
C SAVES FOR SLASH REPEAT FEATURE 6/74
IJ=IJ+1
DO 1006 K=1,JJ
1006 V(IJ+K)=VX(K)
I=I+JJ
V(I)=CVT
I=I+1
C ADDS CNVRT CODE AT END
IJ=I+2
IF(IAMP.EQ.0)GO TO 1299
C*** MAY 18,71 ** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
V(I)=-9900.-BY
GO TO 8703
C ABOVE IS FOR 'DF' (DUTY FACTOR)
7703 V(IJ)=4.*ALL
8703 I=I+1
GO TO 4773
C FOR SUBROUTINES, -12=NUMS. -11=LETTERS.
6703 CODE=-12.
IF(INP(ML+3).EQ.IEL)CODE=-11.
V(IJ)=2.*ALL
V(IJ+1)=CODE+DF
I=I-1
GO TO 4773
2338 I=I-4
GO TO 4773
C 'REP'
2703 ML=ML+1
VX1=0
VX2=0
VX3=0
IF(N.EQ.IXX)GO TO 2704
INP(ML)=IBLA
INP(ML+1)=IBLA
C WIPES OUT 'EP' IN 'REP'
2704 CALL SCANR
V(IJ)=3.
V(IJ+1)=-66.0
IF(VX1.EQ.32.)VX1=1.
IF(VX1.EQ.0)VX1=LPAR
IF(VX2.EQ.0)VX2=LK-1
V(IJ+2)=VX1+VX2*10000.
KL=VX2
IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
IF(VX3.EQ.0)GO TO 4773
L=VX3
ML=LK+1
DO 1018 KL=ML,L
IF(LPAR.GT.NP(KL).AND.LPAR.LT.31)NP(KL)=LPAR
IF(DUR(KL).LT.0)DUR(KL)=DUR(LK)
C TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
V(I)=V(I-4)+10000.
V(I+1)=3.
V(I+2)=-66.
V(I+3)=V(I-1)
1018 I=I+4
GO TO 4773
2018 V(IJ)=3.
V(IJ+1)=-66.
V(IJ+2)=NW+LK*10000
GO TO 4773
7720 V(I)=LK
V(I+1)=3.
V(I+2)=-67.
ML=ML+4
CALL SCANR
V(I+3)=VX1
I=I+4
L=VX1
IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
GO TO 4773
C TYPE 'DUPL N;' N=INST # TO BE DUPLICATED.
2114 FORMAT(I,72A1)
1899 CALL SCANR
GO TO(1,2,3,4,5),ISUB
1106 KTMP=1
TP=60.
IAMP=0
BW=BY
ITMP=-1
ISUB=5
JA=-1
GO TO 2016
3019 V(I)=990000.00
V(I+1)=4.
V(I+2)=VX1
V(I+3)=VX2/TP
V(I+4)=VX3/TP
I=I+5
BY=BW
C SEPT 18, 70
IF(VX1.EQ.0)GO TO 2308
BW=BW+VX1
V(I)=-9900.-BW
I=I+1
CALL BGSORT(BW)
9003 IF(IAMP.LT.0)GO TO 4003
2016 VX3=0
VX2=0
GO TO 1299
5 IF(VX2.NE.0)GO TO 105
C 'TEMPO/120*;' OR 'TEMPO/1.5 72*;' IS OK.
VX2=VX1
VX1=0
105 IF(VX3.EQ.0)VX3=VX2
IF(VX2.LT.11.)TP=1.
IF(J.EQ.ITMPO)GO TO 3019
PCH(1,KTMP)=VX1
PCH(2,KTMP)=VX2
PCH(3,KTMP)=VX3
C PCH(1)=TIME (2)=MM1 (3)=MM2
KTMP=KTMP+1
IF(IAMP.EQ.0)GO TO 2016
4003 VX1=0
IAMP=0
VX2=VX3
IF(J.EQ.ITMPO)GO TO 3019
PCH(1,KTMP)=0
PCH(2,KTMP)=VX2
PCH(3,KTMP)=VX2
C MM CAN BE FROM 11 UP ITMPO FACTOR FROM 10 DOWN.
C UP TO 30 ITMPO CHANGES MAY BE MADE.
1016 IA=I
IZ=1
3100 V(I-2)=CODE+DF
ISUB=3
5016 IF(IAMP.GE.0)GO TO 1299
117 IF(IZ-2)3013,9004,9004
103 K=INP(ML)
IF(K.EQ.ITT)GO TO 1106
IF(K.EQ.ISEMI)GO TO 1014
IF(K.NE.IBLA) GO TO 1899
ML=ML+1
GO TO 103
C@@@@@@@@ MAY 13,71 @@@@@@
C**********FEB 19,71
C ABOVE
3 IF(VX1.EQ.-99.)GO TO 4022
IF(CODE.EQ.-22.)GO TO 2017
C************ MAY 19,71
IF(CODE.LT.-23.OR.IZ/2*2.EQ.IZ)GO TO 17
C CHECKS PAIRS OF NUMBERS FOR 'RTAP'
2017 IF(VX1.EQ.10000.)GO TO 17
VX1=4./VX1
IF(JJ.NE.1)GO TO 2014
V(I)=VX1
GO TO 114
1217 IF(VX1.EQ.10000.)GO TO 114
C FOR "FINE" IN LIST
C ABOVE EXTENDS RANGE TO GIVE HIGHEST NOTE A CHANCE
V(I+1)=VX2
IF(CODE.EQ.-36.)CALL RANR(V,I)
2217 I=I+1
C SETS UP STRING OF RAND SELECTIONS
GO TO 114
3217 V(I)=V(I-2)
V(I+1)=RB
C FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
GO TO 2217
C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
2014 DO 9006 L=2,JJ
IF(VX(L).EQ.0)GO TO 17
9006 VX1=4./VX(L)+VX1
JJ=1
17 V(I)=VX1
IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 1217
C JUMP IF STRING OF RAND SELECS.
IF(JJ.EQ.1)GO TO 114
L=VX(JJ)-1
X=V(I)
NL=I+1
I=L+I
DO 1017 K=NL,I
1017 V(K)=X
C ADDS UP TOTAL OF NOTES IN SEQ.
IZ=IZ+L
GO TO 114
1014 IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 3217
V(I)=RB
C RB SAVES IT FOR SLASH REPEAT
114 RB=V(I)
I=I+1
IZ=IZ+1
GO TO 5016
4022 JC=VX2+.3
JD=VX3-.5
IF(JJ.EQ.2)JD=1
C********* MAY 19,71 ----MANY LINES ABOVE.
IZ=IZ+JC*JD
C JC=HOW MANY TIMES, JD=HOW MANY NOTES
DO 1005 K=1,JD
NL=I+JC-1
DO 2005 L=I,NL
2005 V(L)=V(L-JC)
1005 I=I+JC
RB=V(NL)
C RB SAVES DATA FOR SLASH REPEAT FEATURE.
GO TO 5016
9004 IF(ITMP.EQ.0)GO TO 3013
C*********** JUNE 1,71
KA=1
IC=1
K=0
J=1
Z=0
RC=0
9007 Y=PCH(3,IC)/TP
X=PCH(2,IC)/TP
Z=PCH(1,IC)
CALL SQYY(YY,X,Y,Z)
XT(1)=X
XA=RA
RD=1
RB=0
ZZ=Z
7020 RA=V(IA+K)
IF(RA.EQ.10000.)GO TO 3013
4020 CALL ACCL(RA,KA,RC,XA,Z,Y,X,XT(J),YY,RB,W)
IF(RC.NE.0)GO TO 1011
V(IA+K)=RA*RD
IF(K.EQ.IZ)GO TO 3013
C*********** JUNE 1,71
1011 IF(T5.EQ.1)GO TO 2011
K=K+1
IF(ZZ.NE.0)Z=Z-W
IF(Z.GT.0.OR.RB.EQ.-1.)GO TO 7020
IC=IC+1
IF(RB.EQ.W)GO TO 9007
KA=0
K=K-1
GO TO 9007
C********* MAY 13,71 OMITS REPEATED RHY. FEATURE.
3013 V(I)=CVT
I=I+1
C ADDS ONE FOR CONVRT CODE (0, -1 OR 1)
X=I-IJ
V(IJ+2)=X-4.
V(IJ)=X*ALL
GO TO 4773
2011 CALL ACCL2(XA,RA,K,ZPAR,CHN,ZZ,KA,X,Y,Z,YY,PR)
GO TO 4020
END